home *** CD-ROM | disk | FTP | other *** search
/ Languguage OS 2 / Languguage OS II Version 10-94 (Knowledge Media)(1994).ISO / a_utils / ffccflow / ffccflow.lha / ffccc+flow / ffccc / SECPAS.f < prev    next >
Text File  |  1992-07-31  |  20KB  |  505 lines
  1.       SUBROUTINE SECPAS(NGLOBF,LIMPNO)  
  2.       include 'PARAM.h' 
  3.       include 'ALCAZA.h' 
  4.       include 'CLASS.h' 
  5.       include 'CURSTA.h' 
  6.       include 'FLWORK.h' 
  7.       include 'KEYCOM.h' 
  8.       include 'TYPDEF.h' 
  9.       include 'JOBSUM.h' 
  10.       include 'STATE.h' 
  11.       include 'FLAGS.h' 
  12.       include 'USIGNO.h' 
  13.       include 'USLIST.h' 
  14.       include 'USGCOM.h' 
  15.       include 'USSTMT.h' 
  16.       include 'USUNIT.h' 
  17.       include 'USARGS.h' 
  18.       include 'USLTYD.h' 
  19.       include 'CHECKS.h' 
  20.       PARAMETER (MNUMP=100) 
  21.       CHARACTER*(MXNMCH) CNAM,CNAMF,CNAMP(MNUMP)
  22.       CHARACTER*(NOARG) CSTRIN,CDIM,CDIMN(10)   
  23.       CHARACTER*(MDIMST) CSTAT  
  24.       INTEGER ICNAMP(MNUMP),NSEND2(700) 
  25.       INTEGER IDO(100)  
  26.       LOGICAL LIMPNO,BTEST  
  27.       IOSM = 0  
  28.       IOSP = 0  
  29.       IOSD = 0  
  30.       IOSS = 0  
  31.       IOSO = 0  
  32.       IOSE = 0  
  33.       NSTFUN = 0
  34.       NUMP = 0  
  35.       NUMF = 0  
  36.       NSTFIN = 0
  37.       DO 10 II=1,MNUMP  
  38.          CNAMP(II)='        '   
  39.          ICNAMP(II) = 0 
  40.    10 CONTINUE  
  41.       DO 20 I=1,100 
  42.          IDO(I) = 0 
  43.    20 CONTINUE  
  44.       MNTDO=0   
  45.       MNTIF=0   
  46.       NKALL=0   
  47.       LIMPNO = .FALSE.  
  48.       DO 330 IST=1,NSTAMM   
  49.          ICL1 = ICLASS(IST,1)   
  50.          ICL2 = ICLASS(IST,2)   
  51.          IF(ICL1.EQ.0.OR.ICL1.EQ.999)                           GOTO 330
  52.          NST = NFLINE(IST)  
  53.          NFI = NLLINE(IST)  
  54. C GET STATEMENT NAMES   
  55.          ICURCL(1)=ICL1 
  56.          ICURCL(2)=ICL2 
  57.          ISNAME = IRNAME+NRNAME 
  58.          CALL EXTRAC(IST,'FULL')
  59.          CALL GETALL
  60. C make check for MIXED MODE EXPRESSIONS 
  61.          IF(LCHECK(37)) CALL MIXMOD(NGLOBF) 
  62. C if TREE info, find current DO/IF level. After Grote.  
  63.          IF(ACTION(29)) THEN
  64.             ICLE=ISTMDS(6,ICURCL(1))
  65.             IF(ICLE.EQ.39) THEN 
  66.                MNTIF=MNTIF+1
  67.             ELSEIF(ICLE.EQ.27) THEN 
  68.                MNTIF=MNTIF-1
  69.             ELSEIF(ICLE.EQ.20) THEN 
  70.                IF(MNTDO.LT.100) THEN
  71.                   MNTDO=MNTDO+1 
  72.                   CALL GETINT(SSTA,1,NCHST,KFCH,KLCH,NN)
  73.                   IDO(MNTDO)=NN 
  74.                ENDIF
  75.             ELSEIF(MNTDO.GT.0) THEN 
  76.                K=NEXTIN(SIMA(NFLINE(NSTREF)),1,5)   
  77.                KST=MNTDO
  78.                DO 30 I=KST,1,-1 
  79.                   IF(IDO(I).NE.K)                                GOTO 40
  80.                   MNTDO=MNTDO-1 
  81.    30          CONTINUE 
  82.    40          CONTINUE 
  83.             ENDIF   
  84. C check for CALL
  85.             IF(ICLE.EQ.7) THEN  
  86.                IF(NKALL.LT.MKALL) THEN  
  87.                   NKALL = NKALL + 1 
  88.                   CKALLN(NKALL) = SNAMES(ISNAME+1)  
  89.                   KALLIF(NKALL) = MNTIF 
  90.                   KALLDO(NKALL) = MNTDO 
  91.                ENDIF
  92.             ELSE IF(ICL1.EQ.IIF) THEN   
  93.                IF(ISTMDS(6,ICURCL(2)).EQ.7) THEN
  94.                   IF(NKALL.LT.MKALL) THEN   
  95.                      INDB=INDEX(SSTA,'(')+1 
  96.                      CALL SKIPLV(SSTA,INDB,NCHST,.FALSE.,IEN,ILEV)  
  97.                      INDB=IEN+1 
  98.                      IFOU=999   
  99.                      DO 50 ISN=1,NSNAME 
  100.                         IF(NSSTRT(ISN).GT.INDB.AND.NSSTRT(ISN).LT.IFOU) 
  101.      +                  THEN
  102.                            IFOU=NSSTRT(ISN) 
  103.                            ISNF=ISN 
  104.                         ENDIF   
  105.    50                CONTINUE   
  106.                      NKALL = NKALL + 1  
  107.                      CKALLN(NKALL) = SNAMES(ISNAME+ISNF)
  108.                      KALLIF(NKALL) = MNTIF+1
  109.                      KALLDO(NKALL) = MNTDO  
  110.                   ENDIF 
  111.                ENDIF
  112.             ENDIF   
  113. C check for use of FUNCTIONs
  114.             IF(ICLE.EQ.2.OR.ISTMDS(6,ICURCL(2)).EQ.2) THEN  
  115. C this is an assignment statement   
  116.                DO 80 IS=1,NSNAME
  117.                   DO 60 IR=1,NRNAME 
  118.                      IF(SNAMES(IR+IRNAME).NE.SNAMES(IS+ISNAME))  GOTO 60
  119.                                                                  GOTO 70
  120.    60             CONTINUE  
  121.                                                                  GOTO 80
  122.    70             IF(.NOT.BTEST(NAMTYP(IR+IRNAME),16))           GOTO 80
  123.                   IF(NKALL.GE.MKALL)                             GOTO 90
  124.                   NKALL = NKALL+1   
  125.                   CKALLN(NKALL) = SNAMES(IR+IRNAME) 
  126.                   KALLIF(NKALL) = MNTIF 
  127.                   KALLDO(NKALL) = MNTDO 
  128.                   IF(ICLE.EQ.IIF) KALLIF(NKALL) = MNTIF+1   
  129.    80          CONTINUE 
  130.    90          CONTINUE 
  131.             ENDIF   
  132.          ENDIF  
  133. C remove all blanks in statement
  134.          DO 100 IS=1,NSNAME 
  135.             NSEND2(IS)=NSEND(IS)
  136.   100    CONTINUE   
  137.          NCHAS = 0  
  138.          DO 120 IC=1,NCHST  
  139.             IF(SSTA(IC:IC).EQ.' ') THEN 
  140. C update NSEND into NSEND2  
  141.                DO 110 ISN=1,NSNAME  
  142.                   IF(NSEND2(ISN).GT.IC) NSEND2(ISN)=NSEND2(ISN)-1   
  143.   110          CONTINUE 
  144.                                                                 GOTO 120
  145.             ENDIF   
  146.             NCHAS = NCHAS + 1   
  147.             CSTAT(NCHAS:NCHAS) = SSTA(IC:IC)
  148.   120    CONTINUE   
  149. C   
  150. C trap IMPLICIT NONE or IMPLICIT LOGICAL(A-Z)   
  151.          IF(INDEX(CSTAT,'IMPLICITNONE').NE.0) LIMPNO=.TRUE. 
  152.          IF(INDEX(CSTAT,'IMPLICITLOGICAL(A-Z)').NE.0) LIMPNO=.TRUE. 
  153.          IF(ICL1.EQ.ILL)                                        GOTO 330
  154. C   
  155. C At module start, find argument list if any
  156.          IF(LMODUL(ICL1)) THEN  
  157.             NARGS = NSNAME - 1  
  158.             DO 130 IA=1,NARGS   
  159.                CARGNM(IA) = SNAMES(ISNAME+1+IA) 
  160.   130       CONTINUE
  161.          ENDIF  
  162. C   
  163. C within module, check for dimensionality of items in argument list 
  164.          IF(ICL1.EQ.0.OR.ICL1.EQ.999.OR.LIFF(ICL1))             GOTO 250
  165.          DO 240 ISN=1,NSNAME
  166. C find name in routine list for NAMTYP check
  167.             DO 140 IRN=1,NRNAME 
  168.                IF(SNAMES(IRN+IRNAME).EQ.SNAMES(ISN+ISNAME))     GOTO 150
  169.   140       CONTINUE
  170.                                                                 GOTO 240
  171.   150       NTYP = NAMTYP(IRN+IRNAME)   
  172.             CNAM = ' '  
  173.             CNAM = SNAMES(ISN+ISNAME)   
  174.             ILEN1 = INDEX(CNAM,' ')-1   
  175.             IF(ILEN1.EQ.-1) ILEN1 = MXNMCH  
  176.             IFOU = 0
  177.             DO 160 IARG=1,NARGS 
  178.                ILEN2 = INDEX(CARGNM(IARG),' ')-1
  179.                IF(ILEN2.EQ.-1) ILEN2 = MXNMCH   
  180.                IF(ILEN2.NE.ILEN1)                               GOTO 160
  181.                IF(CARGNM(IARG)(:ILEN2).NE.CNAM(:ILEN1))         GOTO 160
  182.                IFOU = IARG  
  183.                                                                 GOTO 170
  184.   160       CONTINUE
  185.   170       IF(IFOU.EQ.0)                                       GOTO 240
  186. C found in argument list
  187. C   
  188.             IF(.NOT.BTEST(NTYP,17).AND..NOT.BTEST(NTYP,5)) THEN 
  189. C fill info in USARGS   
  190.                IF(ACTION(29)) THEN  
  191.                   IF(CARGTY(IFOU).EQ.' ') THEN  
  192.                      IF(BTEST(NTYP,4)) CARGTY(IFOU)='DOUBLEPRECISION'   
  193.                      LG = INDEX(CARGTY(IFOU),' ')   
  194.                      IF(BTEST(NTYP,0)) CARGTY(IFOU)(LG:)='INTEGER'  
  195.                      IF(BTEST(NTYP,1)) CARGTY(IFOU)(LG:)='REAL' 
  196.                      IF(BTEST(NTYP,2)) CARGTY(IFOU)(LG:)='LOGICAL'  
  197.                      IF(BTEST(NTYP,3)) CARGTY(IFOU)(LG:)='COMPLEX'  
  198.                   ENDIF 
  199.                ENDIF
  200.                                                                 GOTO 240
  201.             ENDIF   
  202.             IF(LDIMEN(ICL1)) THEN   
  203. C dimensioned or character variable 
  204. C first treat CHARACTER*() cases
  205. C   
  206.                IC1 = 13 
  207.                IF(INDEX(CSTAT,'CHARACTER*').NE.0) THEN  
  208.                   IC1 = 12  
  209.                   IPOSS = INDEX(CSTAT(:NCHAS),'CHARACTER*')+10  
  210.                   ILEV = 0  
  211.                   CDIM = ' '
  212.                   N = 0 
  213.                   DO 180 IC=IPOSS,NCHAS 
  214.                      IF(CSTAT(IC:IC).EQ.'(') THEN   
  215.                         ILEV = ILEV + 1 
  216.                         IF(N.GT.0.AND.ILEV.EQ.1)                GOTO 190
  217.                         IF(ILEV.EQ.1)                           GOTO 180
  218.                      ELSE IF(CSTAT(IC:IC).EQ.')') THEN  
  219.                         ILEV = ILEV - 1 
  220.                         IF(ILEV.EQ.0)                           GOTO 190
  221.                      ENDIF  
  222.                      N = N+1
  223.                      CDIM(N:N) = CSTAT(IC:IC)   
  224.   180             CONTINUE  
  225.   190             CONTINUE  
  226. C fill info in USARGS   
  227.                   IF(N.EQ.0) THEN   
  228.                      N = 1  
  229.                      CDIM(1:1) = '?'
  230.                   ENDIF 
  231.                   IF(ACTION(29)) THEN   
  232.                      CARGTY(IFOU) = 'CHARACTER*('//CDIM(:N)//')'
  233.                      NARGDI(IFOU) = 0   
  234.                   ENDIF 
  235.                   IF(LCHECK(38).AND.CDIM(1:1).NE.'*') THEN  
  236.                      WRITE(MZUNIT,500) CNAM 
  237.                      NGLOBF = NGLOBF + 1
  238.                                                                 GOTO 240
  239.                   ENDIF 
  240.                ENDIF
  241. C   
  242. C now CHARACTER with length later or modified length
  243.                IPOS = NSEND2(ISN)+1 
  244.                IF(LCHARC(ICL1).OR.IC1.EQ.12) THEN   
  245.                   N = 0 
  246.                   ILEV = 0  
  247.                   CDIM = ' '
  248.                   ISTAR = 0 
  249.                   DO 200 IC=IPOS,NCHAS  
  250.                      IF(CSTAT(IC:IC).EQ.'(') THEN   
  251.                         ILEV = ILEV + 1 
  252.                                                                 GOTO 200
  253.                      ELSE IF(CSTAT(IC:IC).EQ.')') THEN  
  254.                         ILEV = ILEV - 1 
  255.                                                                 GOTO 200
  256.                      ELSE IF(CSTAT(IC:IC).EQ.'*') THEN  
  257.                         IF(ILEV.EQ.0) THEN  
  258.                            ISTAR = 1
  259.                                                                 GOTO 200
  260.                         ENDIF   
  261.                      ENDIF  
  262.                      IF(ILEV.EQ.0.AND.CSTAT(IC:IC).EQ.',')      GOTO 210
  263.                      IF(ISTAR.EQ.0)                             GOTO 200
  264.                      N = N + 1  
  265.                      CDIM(N:N) = CSTAT(IC:IC)   
  266.   200             CONTINUE  
  267.   210             CONTINUE  
  268. C fill info in USARGS   
  269.                   IF(N.EQ.0) THEN   
  270.                      N = 1  
  271.                      CDIM(:1) = '?' 
  272.                   ENDIF 
  273.                   IF(ACTION(29)) THEN   
  274.                      CARGTY(IFOU) = 'CHARACTER*('//CDIM(:N)//')'
  275.                      NARGDI(IFOU) = 0   
  276.                   ENDIF 
  277.                   IF(LCHECK(39)) THEN   
  278.                      IF((CDIM(1:1).NE.'*'.AND.IC1.EQ.13).OR. (N.GT.0.AND
  279.      +               .IC1.EQ.12.AND.CDIM(1:1).NE.'*')) THEN 
  280.                         WRITE(MZUNIT,500) CNAM  
  281.                         NGLOBF = NGLOBF + 1 
  282.                                                                 GOTO 240
  283.                      ENDIF  
  284.                   ENDIF 
  285.                                                                 GOTO 240
  286.                ENDIF
  287. C a dimensioned non-character variable  
  288.                IPOS2 = INDEX(CSTAT(IPOS:NCHAS),'(')+IPOS
  289.                IF(IPOS2.EQ.IPOS)                                GOTO 240
  290.                IF(IPOS2.NE.IPOS+1)                              GOTO 240
  291.                CALL SKIPLV(CSTAT,IPOS2,NCHAS,.FALSE.,IEN,ILEV)  
  292. C dimension clause spans IPOS2 to IEN-1 
  293.                ISTA = IPOS2 
  294.                IFIN = IEN-1 
  295.                NDIM = 0 
  296.                CDIM = ' '   
  297.                N = 0
  298.                DO 220 IC=ISTA,IFIN  
  299.                   IF(CSTAT(IC:IC).EQ.',') THEN  
  300.                      NDIM = NDIM + 1
  301.                      CDIMN(NDIM) = ' '  
  302.                      CDIMN(NDIM) = CDIM(:N) 
  303.                      CDIM = ' ' 
  304.                      N = 0  
  305.                                                                 GOTO 220
  306.                   ENDIF 
  307.                   N = N + 1 
  308.                   CDIM(N:N) = CSTAT(IC:IC)  
  309.   220          CONTINUE 
  310.                IF(N.EQ.0) THEN  
  311.                   N = 1 
  312.                   CDIM(1:1) = '?'   
  313.                ENDIF
  314.                NDIM = NDIM + 1  
  315.                CDIMN(NDIM) = ' '
  316.                CDIMN(NDIM) = CDIM(:N)   
  317.                CARGTY(IFOU) = ' '   
  318. C fill info in USARGS   
  319.                IF(ACTION(29)) THEN  
  320.                   IF(BTEST(NTYP,4)) CARGTY(IFOU)='DOUBLEPRECISION'  
  321.                   LG = INDEX(CARGTY(IFOU),' ')  
  322.                   IF(BTEST(NTYP,0)) CARGTY(IFOU)(LG:)='INTEGER' 
  323.                   IF(BTEST(NTYP,1)) CARGTY(IFOU)(LG:)='REAL'
  324.                   IF(BTEST(NTYP,2)) CARGTY(IFOU)(LG:)='LOGICAL' 
  325.                   IF(BTEST(NTYP,3)) CARGTY(IFOU)(LG:)='COMPLEX' 
  326.     
  327.                   NARGDI(IFOU) = NDIM   
  328.                   DO 230 I=1,NDIM   
  329.                      CDIM=CDIMN(I)  
  330.                      ICOLON=INDEX(CDIM,':') 
  331.                      IF(ICOLON.NE.0) THEN   
  332.                         CARGDI(I,1,IFOU)=CDIM(1:ICOLON-1)   
  333.                         CARGDI(I,2,IFOU)=CDIM(ICOLON+1:INDEX(CDIM,' ')  
  334.      +                  -1) 
  335.                      ELSE   
  336.                         CARGDI(I,1,IFOU)='1'
  337.                         CARGDI(I,2,IFOU)=CDIM   
  338.                      ENDIF  
  339.   230             CONTINUE  
  340.                ENDIF
  341.                IF(NDIM.EQ.0)                                    GOTO 240
  342.                ICOLON = INDEX(CDIMN(NDIM),':')  
  343.                IF(ICOLON.NE.0) THEN 
  344.                   ILEN = INDEX(CDIMN(NDIM),' ')-1   
  345.                   IF(ILEN.EQ.-1) ILEN = NOARG   
  346.                   CDIM = CDIMN(NDIM)(ICOLON+1:ILEN) 
  347.                ELSE 
  348.                   CDIM = CDIMN(NDIM)
  349.                ENDIF
  350.                IF(LCHECK(44).AND.CDIM(1:1).NE.'*') THEN 
  351.                   WRITE(MZUNIT,510) CNAM
  352.                   NGLOBF = NGLOBF + 1   
  353.                                                                 GOTO 240
  354.                ENDIF
  355.             ENDIF   
  356.   240    CONTINUE   
  357.   250    CONTINUE   
  358.          IF(LMODUS(ICL1)) THEN  
  359. C Module start  
  360.             IF(LCHECK(39).AND.IOSE+IOSO+IOSS+IOSD+IOSP.NE.0) THEN   
  361.                WRITE(MZUNIT,550) (SIMA(I),I=NST,NFI)
  362.             ENDIF   
  363.             IOSM = 1
  364.          ELSE IF(LDECLR(ICL1)) THEN 
  365. C PARAMETER etc 
  366.             IF(LCHECK(39).AND.IOSD+IOSS+IOSO+IOSE.NE.0) THEN
  367.                WRITE(MZUNIT,550) (SIMA(I),I=NST,NFI)
  368.                NGLOBF = NGLOBF + 1  
  369.             ENDIF   
  370.             IOSP = 1
  371.          ELSE IF(LDATA(ICL1)) THEN  
  372. C DATA Statement
  373.             IF(LCHECK(39).AND.IOSS+IOSO+IOSE.NE.0) THEN 
  374.                WRITE(MZUNIT,550) (SIMA(I),I=NST,NFI)
  375.                NGLOBF = NGLOBF + 1  
  376.             ENDIF   
  377.             IOSD = 1
  378.          ELSE IF(ICL1.EQ.IEND) THEN 
  379. C END Statement 
  380.             IOSE = 1
  381.          ELSE IF(LASIGN(ICL1)) THEN 
  382. C Possible statement function   
  383.             IFOUN = 0   
  384.             DO 270 IN=1,NRNAME  
  385.                IF(.NOT.BTEST(NAMTYP(IRNAME+IN),9))              GOTO 270
  386.                CNAM = SNAMES(IRNAME+IN) 
  387.                ILEN = INDEX(CNAM,' ')-1 
  388.                IF(ILEN.EQ.-1) ILEN = MXNMCH 
  389. C Search for the statement function name at the left of 
  390. C an '=' sign . Simple approach but probably not rigorous . 
  391.                IND = INDEX(SIMA(NST),CNAM(:ILEN))   
  392. C   
  393. C CONFIRM THAT THIS IS THE FIRST NAME ON THE LINE   
  394. C   
  395.                DO 259 ICHP=7,IND-1  
  396.                   IF(SIMA(NST)(ICHP:ICHP).NE.' ') GOTO 270  
  397.   259          CONTINUE 
  398.                INDE = INDEX(SIMA(NST),'=')  
  399.                IF(INDE.LT.IND)                                  GOTO 270
  400.                IF(IND.EQ.0)                                     GOTO 270
  401.                DO 260 ILOC=IND+ILEN,MXLINE  
  402.                   IF(SIMA(NST)(ILOC:ILOC).EQ.' ')               GOTO 260
  403.                   IF(SIMA(NST)(ILOC:ILOC).EQ.'=') THEN  
  404.                      IFOUN = 1  
  405.                      CNAMF = CNAM   
  406.                                                                 GOTO 280
  407.                   ELSE IF(SIMA(NST)(ILOC:ILOC).EQ.'(') THEN 
  408.                      NP = 0 
  409.                      IF(NUMP.GE.MNUMP) THEN 
  410.                         WRITE(MZUNIT,520)   
  411.                                                                 GOTO 280
  412.                      ENDIF  
  413.                      NUMP = NUMP + 1
  414.                                                                 GOTO 260
  415.                   ENDIF 
  416.                   IF(SIMA(NST)(ILOC:ILOC).GE.'A'.AND. SIMA(NST) 
  417.      +            (ILOC:ILOC) .LE.'Z') THEN 
  418.                      NP = NP + 1
  419.                      IF(NP.GT.MXNMCH)                           GOTO 260
  420.                      CNAMP(NUMP)(NP:NP) = SIMA(NST)(ILOC:ILOC)  
  421.                   ENDIF 
  422.                   IF(SIMA(NST)(ILOC:ILOC).EQ.',') THEN  
  423.                      NP = 0 
  424.                      IF(NUMP.GE.MNUMP) THEN 
  425.                         WRITE(MZUNIT,520)   
  426.                                                                 GOTO 280
  427.                      ENDIF  
  428.                      NUMP = NUMP + 1
  429.                   ENDIF 
  430.   260          CONTINUE 
  431.   270       CONTINUE
  432.   280       CONTINUE
  433.             IF(IFOUN.EQ.1) THEN 
  434.                NUMF = NUMF + 1  
  435. C Check that statement function surrounded by comment cards 
  436.                IF(NSTFUN.EQ.0) THEN 
  437.                   NSTFUN = NST  
  438.                   IF(LCHECK(40)) THEN   
  439.                      IF(SIMA(NST-1)(1:1).NE.'C'.AND.SIMA(NST-1)(1:1).NE.
  440.      +               '*') THEN  
  441.                         WRITE(MZUNIT,530) CNAMF 
  442.                         NGLOBF = NGLOBF + 1 
  443.                      ENDIF  
  444.                   ENDIF 
  445.                ENDIF
  446.                NSTFIN = NFI+1   
  447.                IOSS = 1 
  448.                IF(LCHECK(39).AND.IOSO+IOSE.NE.0) THEN   
  449.                   WRITE(MZUNIT,550) (SIMA(I),I=NST,NFI) 
  450.                   NGLOBF = NGLOBF + 1   
  451.                ENDIF
  452.             ELSE
  453. C OTHER Statement   
  454.                IF(LCHECK(39).AND.IOSE.EQ.1) THEN
  455.                   WRITE(MZUNIT,550) (SIMA(I),I=NST,NFI) 
  456.                   NGLOBF = NGLOBF + 1   
  457.                ENDIF
  458.                IOSO = 1 
  459.             ENDIF   
  460. C Single occurences of names forced here
  461.             DO 300 II=1,NUMP-1  
  462.                CNAM=CNAMP(II)   
  463.                DO 290 IJ=II+1,NUMP  
  464.                   IF(CNAM.EQ.CNAMP(IJ)) ICNAMP(IJ)=ICNAMP(II)   
  465.   290          CONTINUE 
  466.   300       CONTINUE
  467. C Check that statement function variables are not used elsewhere
  468.             IF(IFOUN.EQ.0) THEN 
  469.                DO 320 ISN=1,NSNAME  
  470.                   CNAM = SNAMES(ISNAME+ISN) 
  471.                   DO 310 ISN2=1,NUMP
  472.                      IF(CNAM.EQ.CNAMP(ISN2)) THEN   
  473.                         IF(LCHECK(41).AND.ICNAMP(ISN2).EQ.0) THEN   
  474.                            WRITE(MZUNIT,540) CNAM   
  475.                            NGLOBF = NGLOBF + 1  
  476.                         ENDIF   
  477.                         ICNAMP(ISN2) = 1
  478.                                                                 GOTO 320
  479.                      ENDIF  
  480.   310             CONTINUE  
  481.   320          CONTINUE 
  482.             ENDIF   
  483.          ENDIF  
  484.   330 CONTINUE  
  485.       IF(LCHECK(40)) THEN   
  486.          IF(NUMF.GT.1.AND.SIMA(NSTFIN)(1:1).NE.'C'.AND. SIMA(NSTFIN)
  487.      +   (1:1) .NE.'*') THEN
  488.             WRITE(MZUNIT,530) CNAMF 
  489.             NGLOBF = NGLOBF + 1 
  490.          ENDIF  
  491.       ENDIF 
  492.       RETURN
  493.   500 FORMAT(1X,'!!! WARNING ... ARGUMENT ',A,' PASSED TO THIS ',   
  494.      +'MODULE, IS NOT CHARACTER*(*)')   
  495.   510 FORMAT(1X,'!!! WARNING ... ARGUMENT ',A,' PASSED TO THIS ',   
  496.      +'MODULE, DOES NOT HAVE LAST DIMENSION "*"')   
  497.   520 FORMAT(1X,'!!! NON-FATAL ERROR IN SECPAS . MNUMP EXCEEDED')   
  498.   530 FORMAT(1X,'!!! WARNING ... STATEMENT FUNCTION ',A,' IS NOT',  
  499.      +' SURROUNDED BY COMMENTS')
  500.   540 FORMAT(1X,'!!! WARNING ... VARIABLE ',A,  
  501.      +',IN STATEMENT FUNCTION DEFINITION, IS USED ELSEWHERE')   
  502.   550 FORMAT(1X,'!!! WARNING ... FOLLOWING STATEMENT IS',   
  503.      +' OUT OF ORDER ',(/,1X,A80))  
  504.       END   
  505.